home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-10-12 | 2.8 KB | 119 lines | [TEXT/CWIE] |
- unit WEUtilities;
-
- { WASTE PROJECT }
- { Interface to miscellaneous utility routines }
- { Most routines are defined in WASTEUtils.Lib }
-
- { Copyright © 1993-1995 Marco Piovanelli }
- { All Rights Reserved }
-
- interface
- uses
- Types, Memory;
-
- const
-
- { result codes }
-
- weUndefinedSelectorErr = -50;
-
- { values for WEAllocate allocFlags parameter }
-
- kAllocClear = $0001; { clear handle after allocation }
- kAllocTemp = $0002; { use temporary memory if available }
-
- type
-
- WEFieldDescriptor = record
- fOffset: Integer;
- fLength: Integer;
- end; { WEFieldDescriptor }
-
- WELookupTableElement = record
- selector: LongInt;
- desc: WEFieldDescriptor;
- end; { WELookupTableElement }
- WELookupTableElementPtr = ^WELookupTableElement;
-
- WELookupTable = array[0..0] of WELookupTableElement;
-
- var
-
- { externally defined global variables }
-
- {$PUSH}
- {$J+}
-
- _weMainSelectorTable: WELookupTable;
- _weObjectHandlerSelectorTable: WELookupTable;
-
- {$POP}
-
- procedure _WEForgetHandle (var h: univ Handle);
- function _WESetHandleLock (h: univ Handle;
- lock: Boolean): Boolean;
- procedure _WEBlockClr (blockPtr: Ptr;
- blockSize: Size);
- function _WEBlockCmp (block1, block2: Ptr;
- blockSize: Size): Boolean;
- function _WEInsertSlot (h: univ Handle;
- element: univ Ptr;
- insertAt: LongInt;
- slotSize: Size): OSErr;
- function _WERemoveSlot (h: univ Handle;
- removeAt: LongInt;
- slotSize: Size): OSErr;
- procedure _WEReorder (var a, b: LongInt);
- function _WEGetField ({const} var table: WELookupTable;
- selector: OSType;
- info: univ Ptr;
- structure: univ Ptr): OSErr;
- function _WESetField ({const} var table: WELookupTable;
- selector: OSType;
- info: univ Ptr;
- structure: univ Ptr): OSErr;
- function _WEAllocate (blockSize: Size;
- allocFlags: Integer;
- var h: univ Handle): OSErr;
-
- implementation
-
- function _WEAllocate (blockSize: Size;
- allocFlags: Integer;
- var h: univ Handle): OSErr;
-
- { Allocate a new relocatable block. }
- { AllocFlags may specify whether the block should be cleared and whether }
- { temporary memory should be used. }
-
- var
- theHandle: Handle;
- err: OSErr;
- begin
- theHandle := nil;
-
- { if kAllocTemp is specified, try tapping temporary memory }
- if (BAND(allocFlags, kAllocTemp) <> 0) then
- theHandle := TempNewHandle(blockSize, err);
-
- { if kAllocTemp isn't specified, or TempNewHandle failed, try with current heap }
- if (theHandle = nil) then
- begin
- theHandle := NewHandle(blockSize);
- err := MemError;
- end;
-
- { if kAllocClear is specified, zero the block }
- if (BAND(allocFlags, kAllocClear) <> 0) then
- if (theHandle <> nil) then
- _WEBlockClr(theHandle^, blockSize);
-
- { return handle through VAR parameter }
- h := theHandle;
-
- { return result code }
- _WEAllocate := err;
-
- end; { _WEAllocate }
-
- end.